home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbideu_1 / install.exe / %MAINDIR% / EnhancedError.bas < prev    next >
Encoding:
BASIC Source File  |  1999-05-09  |  10.7 KB  |  301 lines
  1. Attribute VB_Name = "EnhancedErrors_Module"
  2. ' #VBIDEUtils#************************************************************
  3. ' * Programmer Name  : Waty Thierry
  4. ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
  5. ' * E-Mail           : waty.thierry@usa.net
  6. ' * Date             : 14/01/99
  7. ' * Time             : 16:48
  8. ' * Module Name      : Errors
  9. ' * Module Filename  : Errors.bas
  10. ' **********************************************************************
  11. ' * Comments         : Error files for general error handling
  12. ' *
  13. ' *
  14. ' **********************************************************************
  15.  
  16. Option Explicit
  17.  
  18. ' *** Error Collection
  19. Global gcErrors               As New Collection
  20.  
  21. ' *** Exceptions Collection
  22. Global gcExceptions           As New Collection
  23.  
  24. ' *** View message box or not
  25. Global gbViewMessage          As Boolean
  26.  
  27. ' *** Const ***
  28. Global Const MESSAGE_YES = True
  29.  
  30. Public Function TreatErrorHandler() As Integer
  31.    ' #VBIDEUtils#************************************************************
  32.    ' * Programmer Name  : Waty Thierry
  33.    ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
  34.    ' * E-Mail           : waty.thierry@usa.net
  35.    ' * Date             : 14/01/99
  36.    ' * Time             : 16:49
  37.    ' * Module Name      : Errors
  38.    ' * Module Filename  : Errors.bas
  39.    ' * Procedure Name   : TreatErrorHandler
  40.    ' * Parameters       :
  41.    ' **********************************************************************
  42.    ' * Comments         :
  43.    ' *  This function :
  44.    ' *  - Gets the error
  45.    ' *  - Verifies the error collections
  46.    ' *  - Shows a message box to the user
  47.    ' *  - Tell to the faulty calling routine what to do
  48.    ' ********************************************************
  49.    ' *  Returned value  Identification of what to do.
  50.    ' *                  0 = Resume
  51.    ' *                  1 = Resume next
  52.    ' *                  2 = Exit from the procedure
  53.    ' *                  3 = Cancel the application
  54.    ' *
  55.    ' **********************************************************************
  56.  
  57.    ' #VBIDEUtilsERROR# 'Diseable error handler
  58.    
  59.    ' *** Some variables for the message box
  60.    Dim sMsgTitle        As String         ' Message Box title
  61.    Dim sMsgTxt          As String         ' Text to show in the Message Box
  62.    Dim nMsgAnswer       As Integer        ' Button pressed by the user
  63.    Dim nButtons         As Long
  64.    Dim sSeparator       As String
  65.  
  66.    ' *** Some variables for the error to treat
  67.    Dim nJ               As Integer
  68.    Dim nI               As Integer
  69.    Dim nPos             As Integer
  70.    Dim nCurrentError    As Integer
  71.  
  72.    nCurrentError = Err.Number
  73.    sSeparator = Chr$(10)      ' vbCrLf
  74.  
  75.    ' *** Formatting the error message
  76.    sMsgTitle = "Error N░ " & Str$(nCurrentError)
  77.  
  78.    ' *** Text message
  79.    sMsgTxt = "< " & Err.Description & " >"
  80.  
  81.    If (gcErrors(gcErrors.Count).Details = True) Then
  82.       sMsgTxt = sMsgTxt & sSeparator & sSeparator
  83.       ' *** Add the comment of the user
  84.       sMsgTxt = sMsgTxt & "Comment :" & sSeparator
  85.       sMsgTxt = sMsgTxt & Chr$(9) & gcErrors(gcErrors.Count).Comment & sSeparator & sSeparator
  86.  
  87.       ' *** Localisation of the error
  88.       sMsgTxt = sMsgTxt & "Error Localisation :" & sSeparator
  89.       If (Trim(gcErrors(gcErrors.Count).FormCaption) <> "") Then sMsgTxt = sMsgTxt & Chr$(9) & "Form caption : " & gcErrors(gcErrors.Count).FormCaption & sSeparator
  90.  
  91.       ' *** Identification of the procedure
  92.       If (Trim(gcErrors(gcErrors.Count).ProcName) <> "") Then sMsgTxt = sMsgTxt & Chr$(9) & "Procedure : " & gcErrors(gcErrors.Count).ProcName & sSeparator
  93.  
  94.       ' *** Add the line number if available
  95.       If Erl > 0 Then sMsgTxt = sMsgTxt & Chr$(9) & "Line :" & Chr$(9) & Chr$(9) & Erl & sSeparator
  96.  
  97.       ' *** Show the call stack
  98.       sMsgTxt = sMsgTxt & sSeparator
  99.       sMsgTxt = sMsgTxt & "Calling sequence  :" & sSeparator
  100.  
  101.       nI = 1
  102.       If (gcErrors.Count > 4) Then
  103.          sMsgTxt = sMsgTxt & Chr$(9) & ". . . " & sSeparator
  104.          nI = gcErrors.Count - 4
  105.       End If
  106.  
  107.       For nJ = nI To gcErrors.Count
  108.          sMsgTxt = sMsgTxt & Chr$(9) & gcErrors(nJ).LevelCascade & " : " & gcErrors(nJ).ProcName & sSeparator
  109.       Next
  110.    End If
  111.  
  112.    ' *** Store in the logfile
  113.    LogFile CStr(Now) & " " & sMsgTitle & " " & sMsgTxt
  114.  
  115.    ' *** Show the messagebox if needed
  116.    If (gcErrors(gcErrors.Count).NeedMessageBox = True) Then
  117.       nButtons = gcErrors(gcErrors.Count).Parametres
  118.       If (nButtons = 0) Then nButtons = vbCritical
  119.       nMsgAnswer = MsgBox(sMsgTxt, nButtons, sMsgTitle)
  120.    End If
  121.  
  122.    ' *** Return the value according the selected button
  123.    If (gcErrors(gcErrors.Count).NeedMessageBox = True) Then
  124.       TreatErrorHandler = nMsgAnswer
  125.    Else
  126.       TreatErrorHandler = 1     ' resume next
  127.    End If
  128.  
  129. End Function
  130.  
  131. Private Sub LogFile(sMessage As String)
  132.    ' #VBIDEUtils#************************************************************
  133.    ' * Programmer Name  : Waty Thierry
  134.    ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
  135.    ' * E-Mail           : waty.thierry@usa.net
  136.    ' * Date             : 14/01/99
  137.    ' * Time             : 16:59
  138.    ' * Module Name      : Errors
  139.    ' * Module Filename  : Errors.bas
  140.    ' * Procedure Name   : LogFile
  141.    ' * Parameters       :
  142.    ' *                    sMessage As String
  143.    ' **********************************************************************
  144.    ' * Comments         : Store in the log file
  145.    ' *
  146.    ' *
  147.    ' **********************************************************************
  148.  
  149.    ' #VBIDEUtilsERROR#
  150.    On Error GoTo ERROR_LogFile
  151.  
  152.    On Error Resume Next
  153.  
  154.    Dim nLogFile      As Integer
  155.    Dim sFileName     As String
  156.  
  157.    ' *** Name of the logfile
  158.    sFileName = App.Path + "\LogError.Log"
  159.  
  160.    nLogFile = FreeFile
  161.  
  162.    If (FileLen(sFileName) > 1024000) Then Kill sFileName
  163.    Open sFileName For Append As #nLogFile
  164.    Print #nLogFile, sMessage
  165.    Close #nLogFile
  166.  
  167. EXIT_LogFile:
  168.    Exit Sub
  169.  
  170.    ' #VBIDEUtilsERROR#
  171. ERROR_LogFile:
  172.    Resume EXIT_LogFile
  173.  
  174. End Sub
  175.  
  176. Sub ErrorHandlerEnd(ByVal sProcedureName As String)
  177.    ' #VBIDEUtils#************************************************************
  178.    ' * Programmer Name  : Waty Thierry
  179.    ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
  180.    ' * E-Mail           : waty.thierry@usa.net
  181.    ' * Date             : 14/01/99
  182.    ' * Time             : 17:01
  183.    ' * Module Name      : Errors
  184.    ' * Module Filename  : Errors.bas
  185.    ' * Procedure Name   : ErrorHandlerEnd
  186.    ' * Parameters       :
  187.    ' *                    ByVal sProcedureName As String
  188.    ' **********************************************************************
  189.    ' * Comments         : Called at the end of each procedure
  190.    ' * Used to remove the procedure from the call stack
  191.    ' *
  192.    ' **********************************************************************
  193.  
  194.    If (gcErrors.Count > 0) Then gcErrors.Remove gcErrors.Count
  195.  
  196. End Sub
  197.  
  198. Sub ErrorHandlerBegin(ByVal sProcedureName As String)
  199.    ' #VBIDEUtils#************************************************************
  200.    ' * Programmer Name  : Waty Thierry
  201.    ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
  202.    ' * E-Mail           : waty.thierry@usa.net
  203.    ' * Date             : 14/01/99
  204.    ' * Time             : 17:02
  205.    ' * Module Name      : Errors
  206.    ' * Module Filename  : Errors.bas
  207.    ' * Procedure Name   : ErrorHandlerBegin
  208.    ' * Parameters       :
  209.    ' *                    ByVal sProcedureName As String
  210.    ' **********************************************************************
  211.    ' * Comments         : Called at the beginning of each procedure
  212.    ' * Used to create the call stack
  213.    ' *
  214.    ' **********************************************************************
  215.  
  216.    ' #VBIDEUtilsERROR# 'Diseable error handler
  217.    
  218.    Dim clsError            As New class_Error
  219.  
  220.    ' *** Store the name of the active procedure
  221.    clsError.ProcName = sProcedureName
  222.  
  223.    ' *** Going down from one level
  224.    clsError.LevelCascade = gcErrors.Count + 1
  225.  
  226.    ' *** By default, there is no error
  227.    clsError.ErrorNumber = 0
  228.    clsError.ErrorName = ""
  229.  
  230.    ' *** Add in the collection
  231.    gcErrors.Add Item:=clsError, Key:=CStr(clsError.LevelCascade)
  232.  
  233. End Sub
  234.  
  235. Sub ErrorHandlerParameter(ByVal sComment As String, ByVal nParametres As Long, ByVal bNeedMessageBox As Boolean)
  236.    ' #VBIDEUtils#************************************************************
  237.    ' * Programmer Name  : Waty Thierry
  238.    ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
  239.    ' * E-Mail           : waty.thierry@usa.net
  240.    ' * Date             : 14/01/99
  241.    ' * Time             : 17:05
  242.    ' * Module Name      : Errors
  243.    ' * Module Filename  : Errors.bas
  244.    ' * Procedure Name   : ErrorHandlerParameter
  245.    ' * Parameters       :
  246.    ' *                    ByVal sComment As String
  247.    ' *                    ByVal nParametres As Long
  248.    ' *                    ByVal bNeedMessageBox As Boolean
  249.    ' **********************************************************************
  250.    ' * Comments         : Send parameters
  251.    ' *  - Add more comments
  252.    ' *  - Configure to remove the messagebox
  253.    ' *
  254.    ' **********************************************************************
  255.  
  256.    ' #VBIDEUtilsERROR# 'Diseable error handler
  257.    
  258.    ' *** Store the comment
  259.    gcErrors(gcErrors.Count).Comment = sComment
  260.  
  261.    ' *** Supress or not the error message
  262.    gcErrors(gcErrors.Count).NeedMessageBox = bNeedMessageBox
  263.  
  264.    ' *** Do you want all the details
  265.    gcErrors(gcErrors.Count).Details = True
  266.  
  267.    ' *** Add in the collection
  268.    gcErrors(gcErrors.Count).Parametres = nParametres
  269.  
  270. End Sub
  271.  
  272. Sub ErrorHandlerStartProcedure(ByVal sFormCaption As String, ByVal sProcedureName As String)
  273.    ' #VBIDEUtils#************************************************************
  274.    ' * Programmer Name  : Waty Thierry
  275.    ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
  276.    ' * E-Mail           : waty.thierry@usa.net
  277.    ' * Date             : 14/01/99
  278.    ' * Time             : 17:06
  279.    ' * Module Name      : Errors
  280.    ' * Module Filename  : Errors.bas
  281.    ' * Procedure Name   : ErrorHandlerStartProcedure
  282.    ' * Parameters       :
  283.    ' *                    ByVal sFormCaption As String
  284.    ' *                    ByVal sProcedureName As String
  285.    ' **********************************************************************
  286.    ' * Comments         : Init for a new event
  287.    ' *
  288.    ' *
  289.    ' **********************************************************************
  290.  
  291.    ' #VBIDEUtilsERROR# 'Diseable error handler
  292.    
  293.    ' *** Init a new event
  294.    ErrorHandlerBegin sProcedureName
  295.  
  296.    gcErrors(gcErrors.Count).FormCaption = sFormCaption
  297.    gcErrors(gcErrors.Count).ProcName = sProcedureName
  298.    gcErrors(gcErrors.Count).Comment = ""
  299.  
  300. End Sub
  301.